home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / vbbook13.zip / SOURCE.DOC < prev    next >
Text File  |  1993-04-04  |  21KB  |  592 lines
  1.                         VB BOOK 1.0 Source Code
  2.  
  3.  
  4. NOTE:  This is older code so do NOT use this code to modify VB BOOK!  It 
  5. is included here only to show people without Visual Basic what makes 
  6. VB BOOK click.  
  7.  
  8. The Global form (VBBOOK.BAS):
  9. -----------------------------
  10. Type Flags                           'Misc flag variables
  11.   CurDate As Integer
  12.   DoHeader As Integer
  13.   FileTitle As Integer
  14.   LineLen As Integer
  15.   LineWrap As Integer
  16.   PgNumber As Integer
  17. End Type
  18.  
  19. 'The VBBOOK.FRM form: (used for the first little box that goes away in 5 sec's.)
  20. '--------------------
  21. '(No code in this form.  Just displays a message for 5 secs)
  22.  
  23. 'The VBBOUT.FRM form:
  24. '--------------------
  25. '(No code in this form.  It's a blank, full-page form used to cover up the
  26. 'desktop.  There should be a better way to do this!)
  27.  
  28. 'The Main module, VBBINP.FRM: (This is where all the selections are done.)
  29. '----------------------------
  30. 'Declarations section:
  31. 'Note that Dim Shared is not really needed but VB done it during the automatic
  32. 'conversion from QuickBasic code so I left it that way.  
  33. Dim Shared ESC$, FF$, LF$, filename$, OUTFILE$, NL$
  34. Dim Shared page%, num$, tune%
  35. Dim Shared PC As Flags
  36. Dim lastchange As Integer
  37.  
  38. Const fileboxclick = 0, dirsboxclick = 1         'Used by file selection routine
  39. Const true = -1, false = 0
  40.  
  41. 'Now the Subs start:
  42. Static Sub BuildArray (ptrarray&(), pgcount%)
  43.    MaxLines% = 66                                'Maximum number of lines
  44.    Offset& = 1                                   'Start of file (seek point)
  45.    Open filename$ For Binary Access Read As #1 Len = 1   'Open file to check
  46.    TotalSize& = LOF(1)                           'Get LEN of file so we don't read too far
  47.    FileLeft& = TotalSize&                        'Setup a counter to show whats left
  48.    'FRE is not supported by VB.  Just set it to 64K
  49.    MemAvail& = 65536                             'FRE(FileName$) - 2048            'Check available string memory
  50.    If MemAvail& < 2048 Then Error 14             'Force out of memory error
  51.    SixteenK% = 16384
  52.  
  53.    If TotalSize& > SixteenK% Then                'Set a buffer size
  54.       If MemAvail& > SixteenK% Then              'If the file is larger than 16K
  55.          BufAvail& = SixteenK%                   'Set it to 16k
  56.       Else
  57.          BufAvail& = MemAvail&
  58.       End If
  59.    Else
  60.       If TotalSize& < MemAvail& Then             'Otherwise set it to file size
  61.          BufAvail& = TotalSize&
  62.       End If
  63.       BuffSize% = BufAvail&
  64.    End If
  65.  
  66.    pgcount% = 1                                  'Initialize page count
  67.    ptrarray&(pgcount%) = 1                       'First pointer is always 1
  68.    LnCount% = 0                                  'Initialize line count
  69.  
  70. GetPage:                                         'Read the file
  71.                                                  
  72.   If FileLeft& < BufAvail& Then                  'Check amount left to read
  73.      Buffer$ = Space$(FileLeft&)                 'If less than our buffer, use lessor
  74.   Else
  75.      Buffer$ = Space$(BufAvail&)                 'Otherwise use full buffer size
  76.   End If
  77.  
  78.   Get #1, Offset&, Buffer$                       'Read in a buffers worth
  79.   stptr% = 1                                     'Pointer into buffer$
  80.   LastLine% = 0                                  'remember last position
  81.  
  82. PageCheck:
  83.   TempLn% = InStr(stptr%, Buffer$, LF$)          'Position of next linefeed
  84.   temppg% = InStr(stptr%, Buffer$, FF$)          'Position of next pagefeeds
  85.  
  86.   If temppg% Then                                'If there was a page feed
  87.      If temppg% < TempLn% Or TempLn% = 0 Then    '  was it before our linefeed?
  88.         pgcount% = pgcount% + 1                  '  yes then bump page count
  89.         ptrarray&(pgcount%) = Offset& + temppg%  '  set next array element
  90.         stptr% = temppg% + 1                     '  set instr pointer
  91.         LnCount% = 0                             '  reset linecount
  92.         If stptr% < Len(Buffer$) Then GoTo PageCheck 'and loop back for more
  93.       End If
  94.   End If
  95.  
  96.   If TempLn% Then                                'Linefeed
  97.     If PC.LineWrap Then                           'If Line Wrap, check length
  98.         If TempLn% - stptr% > PC.LineLen Then     'Greater than 80?
  99.             Do                                   'check for line wrap
  100.                 LnCount% = LnCount% + 1          'increment line
  101.                 If LnCount% = MaxLines% Then
  102.                     GoTo PageBreak               '> 66 lines
  103.                 End If
  104.                 stptr% = stptr% + PC.LineLen
  105.             Loop While TempLn% - stptr% > PC.LineLen
  106.         End If
  107.     End If
  108.     LnCount% = LnCount% + 1                      'Increment page count
  109.  
  110. PageBreak:
  111.      If LnCount% = MaxLines% Then
  112.         pgcount% = pgcount% + 1
  113.             If pgcount% > 512 Then
  114.                msg$ = "Too may pages - printing only 512."
  115.                MsgBox msg$, 0, "Notice"
  116.                GoTo EndBuild
  117.             End If
  118.         ptrarray&(pgcount%) = Offset& + TempLn%  'point to next in point in file
  119.         LnCount% = 0
  120.      End If
  121.      
  122.      stptr% = TempLn% + 1                        'point ahead 1 byte for next scan
  123.      If stptr% <= Len(Buffer$) Then
  124.         GoTo PageCheck                           'keep checking
  125.      End If
  126.   End If
  127.  
  128.   Offset& = Offset& + Len(Buffer$)              'Pointer into file (tally)
  129.   stptr% = 1                                    'Reset Buffer pointer
  130.   FileLeft& = TotalSize& - Offset&              'Calculate how much is left
  131.   If Offset& < TotalSize& Then GoTo GetPage     'If more text in file, keep going
  132.  
  133. EndBuild:
  134.   ptrarray&(pgcount% + 1) = TotalSize&          'Set last pointer to end of file
  135.  
  136. Close #1                                        'Close input file
  137. End Sub                                         'End of BuildArray Sub
  138.  
  139. Static Sub DoMacro (num$)
  140.     Print #2, ESC$; "&f"; num$; "y2X";     'execute the macro
  141. End Sub
  142.  
  143. Static Sub EndMacro (num$)
  144.     Print #2, ESC$; "&f"; num$; "y1X";          'Send end of macro command
  145.     Print #2, ESC$; "&f"; num$; "y9X";          'Make it temporary (10 to be permanent)
  146. End Sub
  147.  
  148. Static Sub Header (page%)
  149.     hdr$ = Space$(PC.LineLen)                     'Create a string to print
  150.    
  151.     If PC.FileTitle Then                          'Print the filename
  152.         Mid$(hdr$, 40 - Len(filename$) \ 2) = UCase$(filename$)
  153.     End If
  154.  
  155.     If PC.PgNumber Then                           'Print the current page
  156.         PTemp$ = "Page" + Str$(page%)
  157.         If page% Mod 2 Then
  158.             Mid$(hdr$, PC.LineLen - Len(PTemp$)) = PTemp$ 'odd page, right side
  159.         Else
  160.             Mid$(hdr$, 1) = PTemp$               'even page, left side
  161.         End If
  162.     End If
  163.  
  164.     If PC.CurDate Then                            'Print the current date
  165.         If page% Mod 2 Then
  166.             Mid$(hdr$, 1) = Date$                'even page, left side
  167.         Else
  168.             Mid$(hdr$, PC.LineLen - Len(Date$)) = Date$  'odd page, right side
  169.         End If
  170.     End If
  171.     Print #2, hdr$                               'Print the Header
  172.     Print #2,                                    ' and skip a line for readability
  173.  
  174. End Sub
  175.  
  176. Static Sub LJLocate (X%, Y%)                'Laser Jet cursor locate
  177.     Temp$ = ESC$ + "&a" + LTrim$(Str$(Y%)) + "r" + LTrim$(Str$(X%)) + "C"
  178.     Print #2, Temp$;
  179. End Sub
  180.  
  181. Static Sub printlogo ()                  'Banner logo (About VB Box!)
  182.     msg$ = "                   VB Book" + NL$
  183.     msg$ = msg$ + "     Converted to Visual Basic" + NL$
  184.     msg$ = msg$ + "             by Dennis Scott." + NL$
  185.     msg$ = msg$ + NL$
  186.     msg$ = msg$ + "Send Comments/Suggestions to:" + NL$
  187.     msg$ = msg$ + "               CompuDirect" + NL$
  188.     msg$ = msg$ + "             7711 Bulter Rd" + NL$
  189.     msg$ = msg$ + "             Myrtle Beach, SC" + NL$
  190.     msg$ = msg$ + "               (803)650-7452" + NL$
  191.     MsgBox msg$, 0, "About VB Book"
  192. End Sub
  193.  
  194. Sub PrintSetup ()                               'Send codes to prepare printer
  195.     Print #2, ESC$; "E";                        '